home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / PREVIEW / CLP2DLFI / NUDELPHI.PAS < prev    next >
Pascal/Delphi Source File  |  1995-10-29  |  8KB  |  335 lines
  1. unit Nudelphi;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, DBFserver, CommonCode, wPreview,
  8.   wAboutbx, wDL, wDL2, Menus;
  9.  
  10. const
  11.   wFirstPrgDir='';
  12.   wFieldListDir='';
  13.  
  14. type
  15.   Tdb2dl = class(TForm)
  16.     prglist: TListBox;
  17.     paslist: TListBox;
  18.     OpenDialog1: TOpenDialog;
  19.     cdir: TLabel;
  20.     Label1: TLabel;
  21.     Label2: TLabel;
  22.     BitBtn2: TBitBtn;
  23.     CheckBox1: TCheckBox;
  24.     BitBtn3: TBitBtn;
  25.     Label3: TLabel;
  26.     fromprg: TLabel;
  27.     Label5: TLabel;
  28.     topas: TLabel;
  29.     progress: TLabel;
  30.     BitBtn4: TBitBtn;
  31.     Button1: TButton;
  32.     MainMenu1: TMainMenu;
  33.     Options1: TMenuItem;
  34.     PRGtoPAS1: TMenuItem;
  35.     DBFtoPAS1: TMenuItem;
  36.     procedure FormCreate(Sender: TObject);
  37.     procedure BitBtn1Click(Sender: TObject);
  38.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  39.     procedure BitBtn2Click(Sender: TObject);
  40.     procedure paslistDrawItem(Control: TWinControl; Index: Integer;
  41.       Rect: TRect; State: TOwnerDrawState);
  42.     procedure prglistDrawItem(Control: TWinControl; Index: Integer;
  43.       Rect: TRect; State: TOwnerDrawState);
  44.     procedure BitBtn3Click(Sender: TObject);
  45.     procedure paslistDblClick(Sender: TObject);
  46.     procedure prglistDblClick(Sender: TObject);
  47.     procedure BitBtn4Click(Sender: TObject);
  48.     procedure Exit1Click(Sender: TObject);
  49.     procedure Button1Click(Sender: TObject);
  50.     procedure PRGtoPAS1Click(Sender: TObject);
  51.     procedure DBFtoPAS1Click(Sender: TObject);
  52.   private
  53.     { Private declarations }
  54.     curdir:string;
  55.     dlConv:oDL;
  56.     dbfConv:oFldpas;
  57.     prnpas:lpr;
  58.     procedure procprgs;
  59.         procedure PRG2PAS;
  60.         procedure DBF2PAS;
  61.   public
  62.     { Public declarations }
  63.     indir:string;
  64.     DoPRGconversion:boolean;
  65.         procedure SelDir;
  66.     procedure loadlists;
  67.   end;
  68.  
  69. var
  70.   db2dl: Tdb2dl;
  71.   InstalledTo:string;
  72.  
  73. implementation
  74.  
  75. {$R *.DFM}
  76.  
  77. procedure Tdb2dl.FormCreate(Sender: TObject);
  78. begin
  79.   width:=517;
  80.   height:=345;
  81.   top:=0;
  82.   centerhoriz(self);
  83.   dlConv:=oDL.Create;
  84.   dbfConv:=oFldpas.Create;
  85.   prnpas:=lpr.create;
  86.   fromprg.caption:='';
  87.   topas.caption:='';
  88.   progress.caption:='';
  89.   DoPRGconversion:=true;
  90.   indir:=InstalledTo;
  91.   gen.addwin('Translate xBase',self);
  92. end;
  93.  
  94. procedure Tdb2dl.SelDir;
  95. begin
  96.   with opendialog1 do begin
  97.     title:='Select Any PRG File In This Directory';
  98.     if empty(initialdir) then initialdir:=wFirstPrgDir
  99.     else initialdir:=indir;
  100.     if DoPRGconversion then begin
  101.       filename:='*.Prg';
  102.       filter:='Programs (*.PRG)|*.PRG';
  103.       defaultext:='PRG';
  104.     end else begin
  105.       filename:='*.Dbf';
  106.       filter:='Databases (*.DBF)|*.DBF';
  107.       defaultext:='DBF';
  108.     end;
  109.     execute;
  110.     if files.count>0 then indir:=files[0];
  111.   end;
  112.   LoadLists;
  113. end;
  114.  
  115. procedure Tdb2dl.LoadLists;
  116. var prg:TStringList;
  117.     ii:integer;
  118.     tt:string;
  119. begin
  120.   prg:=TStringList.Create;
  121.     split(indir,'\',pars,parscnt);
  122.   if pin('.',pars[parscnt]) then begin
  123.     parscnt:=parscnt-1;  { knock of file on end }
  124.     indir:=unsplit(pars,'\',parscnt);
  125.   end;
  126.   curdir:=indir;
  127.   cdir.caption:='Current Dir:   '+curdir;
  128.   if DoPRGconversion then LoadFileList(curdir,'*.PRG',prg)
  129.   else LoadFileList(curdir,'*.DBF',prg);
  130.   prglist.clear;
  131.   paslist.clear;
  132.   if prg.count>0 then begin
  133.     for ii:=0 to prg.count-1 do begin
  134.       prglist.items.add(prg[ii]);
  135.     end;
  136.     for ii:=0 to prglist.items.count-1 do begin
  137.         if DoPRGconversion then tt:=indir+'\'+noext(prglist.items[ii])+'.pas'
  138.         else tt:=indir+'\'+noext(prglist.items[ii])+'.int';
  139.       if fileexists(tt) then begin
  140.         paslist.items.add(noext(prglist.items[ii])+'.PAS');
  141.       end else begin
  142.         paslist.items.add('');
  143.       end;
  144.     end;
  145.   end;
  146.   prg.free;
  147.   bitbtn4.caption:='&Select All';
  148. end;
  149.  
  150. procedure Tdb2dl.BitBtn1Click(Sender: TObject);
  151. begin
  152.   close;
  153. end;
  154.  
  155. procedure Tdb2dl.FormClose(Sender: TObject; var Action: TCloseAction);
  156. begin
  157.   prnpas.free;
  158.   dlConv.free;
  159.   dbfConv.free;
  160.   gen.releasewin(self);
  161.   action:=caFree;
  162. end;
  163.  
  164. procedure Tdb2dl.BitBtn2Click(Sender: TObject);
  165. begin
  166.   SelDir;
  167. end;
  168.  
  169. procedure Tdb2dl.paslistDrawItem(Control: TWinControl; Index: Integer;
  170.   Rect: TRect; State: TOwnerDrawState);
  171. var ii:integer;
  172. begin
  173.   with (control as TListBox).Canvas do begin
  174.     ii:=paslist.items.count;
  175.     if prglist.items.count<ii then ii:=prglist.items.count;
  176.       fillrect(rect);
  177.       textout(rect.left+2,rect.top,paslist.items[index]);
  178.     if (prglist.topindex<ii) and (prglist.items.count>0) then
  179.       prglist.topindex:=paslist.topindex;
  180.   end;
  181. end;
  182.  
  183. procedure Tdb2dl.prglistDrawItem(Control: TWinControl; Index: Integer;
  184.   Rect: TRect; State: TOwnerDrawState);
  185. var ii:integer;
  186. begin
  187.   with (control as TListBox).Canvas do begin
  188.     ii:=prglist.items.count;
  189.     if paslist.items.count<ii then ii:=paslist.items.count;
  190.       fillrect(rect);
  191.       textout(rect.left+2,rect.top,prglist.items[index]);
  192.     if (paslist.topindex<ii) and (paslist.items.count>0) then
  193.       paslist.topindex:=prglist.topindex;
  194.   end;
  195. end;
  196.  
  197. procedure Tdb2dl.procprgs;
  198. var ii:integer;
  199.     tt:string;
  200. begin
  201.   if prglist.items.count>0 then begin
  202.     Mousewait;
  203.     for ii:=0 to prglist.items.count-1 do begin
  204.       if prglist.selected[ii] then begin
  205.           tt:=prglist.items[ii];
  206.         fromprg.caption:=tt;
  207.         if doPRGconversion then topas.caption:=noext(tt)+'.PAS'
  208.         else topas.caption:=noext(tt)+'.INT/.IMP';
  209.               DLconv.DoDBWconv:=checkbox1.checked;
  210.               if DoPRGconversion then dlconv.dbase2delphi(curdir,tt)
  211.         else begin
  212.           progress.caption:='';
  213.           dbfConv.dbf2pas(curdir,tt);
  214.           progress.caption:='Done';
  215.           doevents;
  216.         end;
  217.         paslist.items[ii]:=padr(noext(tt)+'.PAS',13)+'*';
  218.       end;
  219.     end;
  220.     MouseGo;
  221.   end;
  222. end;
  223.  
  224. procedure Tdb2dl.BitBtn3Click(Sender: TObject);
  225. begin
  226.   procprgs;
  227. end;
  228.  
  229. procedure Tdb2dl.paslistDblClick(Sender: TObject);
  230. var tt,tt2:string;
  231.     f1,f2:tstringlist;
  232.     ii,seg2:integer;
  233. begin
  234.   tt:=paslist.items[paslist.itemindex];
  235.   if not empty(tt) then begin
  236.     f1:=tstringlist.create;
  237.     f2:=tstringlist.create;
  238.     if DoPRGconversion then begin
  239.       tt:=trim(noext(tt))+'.PAS';
  240.         tt2:=trim(noext(tt))+'.TXT';
  241.     end else begin
  242.       tt:=trim(noext(tt))+'.INT';
  243.       tt2:=trim(noext(tt))+'.IMP';
  244.     end;
  245.       prnpas.setdestination;
  246.       prnpas.startdoc(for8x11,'View '+
  247.       trim(tt+iifs(length(tt2)>0,'/'+tt2,'')));
  248.     f1.loadfromfile(curdir+'\'+tt);
  249.     seg2:=0;
  250.     with prnpas do begin
  251.       for ii:=0 to f1.count-1 do writeln(f1[ii]);
  252.         if not empty(tt2) then begin
  253.         Eject;
  254.         seg2:=prnpas.Page+1;
  255.             f2.loadfromfile(curdir+'\'+tt2);
  256.             textfont('b');
  257.             writeln(padc('FILE: '+tt2,79));
  258.         writeln('');
  259.           textfont('n');
  260.           for ii:=0 to f2.count-1 do writeln(f2[ii]);
  261.       end;
  262.     end;
  263.       prnpas.SetCaption('View '+
  264.       trim(tt+iifs(length(tt2)>0,'/'+tt2+' (Starts Pg '+inttostr(seg2)+
  265.       ')','')));
  266.     prnpas.stopdoc;
  267.     f1.free;
  268.     f2.free;
  269.   end;
  270. end;
  271.  
  272. procedure Tdb2dl.prglistDblClick(Sender: TObject);
  273. begin
  274.   procprgs;
  275. end;
  276.  
  277. procedure Tdb2dl.BitBtn4Click(Sender: TObject);
  278. var ii:integer;
  279.     bool:boolean;
  280. begin
  281.   if prglist.items.count>0 then begin
  282.     if pin('Unselect',bitbtn4.caption) then begin
  283.       bool:=false;
  284.       bitbtn4.caption:='&Select All';
  285.     end else begin
  286.       bool:=true;
  287.       bitbtn4.caption:='&Unselect All';
  288.     end;
  289.     for ii:=0 to prglist.items.count-1 do prglist.selected[ii]:=bool;
  290.     prglist.topindex:=0;
  291.   end;
  292. end;
  293.  
  294. procedure Tdb2dl.Exit1Click(Sender: TObject);
  295. begin
  296.   close;
  297. end;
  298.  
  299. procedure Tdb2dl.PRG2PAS;
  300. begin
  301.   DoPRGconversion:=true;
  302.   label1.caption:='xBase Files';
  303.   checkbox1.visible:=true;
  304.   PRGtoPAS1.checked:=true;
  305.     DBFtoPAS1.checked:=false;
  306.   loadlists;
  307. end;
  308.  
  309. procedure Tdb2dl.DBF2PAS;
  310. begin
  311.   DoPRGconversion:=false;
  312.   label1.caption:='DataBase Files';
  313.   checkbox1.visible:=false;
  314.   PRGtoPAS1.checked:=false;
  315.     DBFtoPAS1.checked:=true;
  316.   loadlists;
  317. end;
  318.  
  319. procedure Tdb2dl.Button1Click(Sender: TObject);
  320. begin
  321.   close;
  322. end;
  323.  
  324. procedure Tdb2dl.PRGtoPAS1Click(Sender: TObject);
  325. begin
  326.   prg2pas;
  327. end;
  328.  
  329. procedure Tdb2dl.DBFtoPAS1Click(Sender: TObject);
  330. begin
  331.   dbf2pas;
  332. end;
  333.  
  334. end.
  335.